home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / comm.swg / 0050_Fossil Engine.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  9KB  |  422 lines
  1.  
  2. UNIT FossilP;  { see demo at end of code }
  3.  
  4. INTERFACE
  5.  
  6. Uses Dos, Crt; { Phone, PXEngine, PxMsg; Config;}
  7.  
  8. Type
  9.   FossilInfo = Record
  10.     MaxFunc    :Byte;   {Max func number supported}
  11.     Revision   :Byte;  {Fossil revision supported}
  12.     MajVer     :Byte;    {Major version}
  13.     MinVer     :Byte;    {Minor version}
  14.     Ident      :PChar;    {Null terminated ID string}
  15.     IBufr      :Word;     {size of input buffer}
  16.     IFree      :Word;     {number of bytes left in buffer}
  17.     OBufr      :Word;     {size of output buffer}
  18.     OFree      :Word;     {number of bytes left in buffer}
  19.     SWidth     :Byte;    {width of screen}
  20.     SHeight    :Byte;   {height of screen}
  21.     Baud       :Byte;      {ACTUAL baud rate, computer to modem}
  22.   End;
  23.  
  24.   FossilInfo2 = Record
  25.     StrucSize   :Word; {Structure size in bytes}
  26.     MajVer      :Byte;    {Major version}
  27.     MinVer      :Byte;    {Minor version}
  28.     Ident       :PChar;    {Null terminated ID string}
  29.     IBufr       :Word;     {size of input buffer}
  30.     IFree       :Word;     {number of bytes left in buffer}
  31.     OBufr       :Word;     {size of output buffer}
  32.     OFree       :Word;     {number of bytes left in buffer}
  33.     SWidth      :Byte;    {width of screen}
  34.     SHeight     :Byte;   {height of screen}
  35.     Baud        :Byte;      {ACTUAL baud rate, computer to modem}
  36.   End;
  37.  
  38. Procedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);
  39. Function  FReadKey:Word;
  40. Procedure FossilInt(var R:Registers);
  41. Procedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);
  42. Procedure InitFossil(var FosInf:FossilInfo; Port:Word);
  43. Procedure DeInitFossil(Port:Word);
  44. Function  FIsKeyPressed:Word;
  45. Function  FossilReadChar(Port:Word):Byte;
  46. Function  FossilIsCharReady(Port:Word):Word;
  47. Function  FossilSendChar(Port:Word; Char:byte):Word;
  48. Procedure Init;
  49. Procedure FossilSendStr(S:String; Port:Word);
  50. Procedure DialNo(Port:Word);
  51. Procedure Run;
  52. Procedure Done;
  53.  
  54. Procedure WriteAnsi;
  55. Procedure HangUp;
  56. Procedure DialRec(Port:Word);
  57.  
  58. IMPLEMENTATION
  59.  
  60. { Fossil Functions }
  61. Procedure FossilInt(var R:Registers);
  62. begin
  63.   Intr($14,R);
  64. End;
  65.  
  66. Procedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);
  67. Var Out : Integer;
  68.     R   : Registers;
  69.     Port: Word;
  70. Begin
  71. Out := 0;
  72. Case Baud Of
  73.     0 :Exit;
  74.   100 :Out := Out + 000 + 00 + 00;
  75.   150 :Out := Out + 000 + 00 + 32;
  76.   300 :Out := Out + 000 + 64 + 00;
  77.  1200 :Out := Out + 128 + 00 + 00;
  78.  2400 :Out := Out + 128 + 00 + 32;
  79.  4800 :Out := Out + 128 + 64 + 00;
  80.  9600 :Out := Out + 128 + 64 + 32;
  81. End;
  82. Case DataBit Of
  83.    5 :Out := Out + 0 + 0;
  84.    6 :Out := Out + 0 + 1;
  85.    7 :Out := Out + 2 + 0;
  86.    8 :Out := Out + 2 + 1;
  87. End;
  88. Case Party Of
  89.  'N'      :Out := Out + 00 + 0;
  90.  'O', 'o' :Out := Out + 00 + 8;
  91.  'n'      :Out := Out + 16 + 0;
  92.  'E', 'e' :Out := Out + 16 + 8;
  93. End;
  94. Case StopBit Of
  95.  1 :Out := Out + 0;
  96.  2 :Out := Out + 4;
  97. End;
  98. R.AH:=0;
  99. R.AL:=Out;
  100. R.DX:=Port;
  101. FossilInt(R);
  102. End;
  103.  
  104. Procedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);
  105. Var
  106.   R: Registers;
  107. Begin
  108.   R.AH:=$1B;             {Function number 1bh}
  109.   R.CX:=SizeOf(FosRec);  {size of user info}
  110.   R.DX:=Port;            {port number}
  111.   R.ES:=Seg(FosRec);     {segment of info buf}
  112.   R.DI:=Ofs(FosRec);     {offset of info buf}
  113.   FossilInt(R);
  114. End;
  115.  
  116. Procedure InitFossil(var FosInf:FossilInfo; Port:Word);
  117. Var
  118.   R :Registers;
  119.   Z :FossilInfo2;
  120. Begin
  121.   R.AH:=$04;
  122.   R.DX:=Port;
  123.   FossilInt(R);
  124.   if R.AX=$1954 then begin {AX should countain 1954h if fossil is loaded}
  125.     FosInf.MaxFunc :=R.BL;
  126.     FosInf.Revision:=R.BH;
  127.     GetFossilInfo(Z,Port);
  128.     with FosInf do begin
  129.       MajVer:= Z.MajVer;
  130.       MinVer:= Z.MinVer;
  131.       Ident := Z.Ident;
  132.       IBufr := Z.IBufr;
  133.       IFree := Z.IFree;
  134.       OBufr := Z.OBufr;
  135.       OFree := Z.OFree;
  136.       SWidth:= Z.SWidth;
  137.       SHeight:=Z.SHeight;
  138.       Baud  := Z.Baud;
  139.     End;
  140.   End Else FosInf.MaxFunc:=0; {MaxFunc contains 0 if fossil is not found}
  141. End;
  142.  
  143. Procedure DeInitFossil(Port:Word);
  144. var
  145.   R: Registers;
  146. Begin
  147.   R.AH:=$05;
  148.   R.DX:=Port;
  149.   FossilInt(R);
  150. End;
  151.  
  152. Function FIsKeyPressed:Word;
  153. var
  154.   R:Registers;
  155. Begin
  156.   R.AH:=$0D;
  157.   FossilInt(R);
  158.   FIsKeyPressed := R.AX;
  159. End;
  160.  
  161. Function FReadKey:Word;
  162. var
  163.   R:Registers;
  164. Begin
  165.   R.AH:=$0E;
  166.   FossilInt(R);
  167.   FReadKey := R.AX;
  168. End;
  169.  
  170. Function FossilReadChar(Port:Word):Byte;
  171. var
  172.   R :Registers;
  173. Begin
  174.   R.AH:=$02;
  175.   R.DX:=Port;
  176.   FossilInt(R);
  177.   FossilReadChar := R.AL
  178. End;
  179.  
  180. Function FossilIsCharReady(Port:Word):Word;
  181. var
  182.   R :Registers;
  183. Begin
  184.   R.AH:=$0C;
  185.   R.DX:=Port;
  186.   FossilInt(R);
  187.   FossilIsCharReady := R.AX;
  188. End;
  189.  
  190. Function FossilSendChar(Port:Word; Char:byte):Word;
  191. var
  192.   R :Registers;
  193. Begin
  194.   R.AH:=$01;
  195.   R.DX:=Port;
  196.   R.AL:=Char;
  197.   FossilInt(R);
  198.   FossilSendChar := R.AX;
  199. End;
  200.  
  201. Const
  202.   CurPort :Word = 1;        {current COM port of modem}
  203.  
  204.   ExitKey=$2d00; {ALT-X}
  205.   DialKey=$2000; {ALT-D}
  206.  
  207.   DialPref:String ='ATDT';
  208.   DialSuf :String =#13;
  209.  
  210. Var
  211.   Z :FossilInfo;
  212.  
  213. Procedure Init;
  214. Begin
  215.   Write('Modem Port(0=COM1):');
  216.   ReadLn(CurPort);
  217.   InitFossil(Z,CurPort);
  218.   if Z.MaxFunc=0 then begin
  219.     WriteLn('ERROR:No FOSSIL driver found!');
  220.     Sound(400);
  221.     Delay(500);
  222.     NoSound;
  223.     Halt(1);
  224.   End;
  225.   WriteLn('Fossil: Rev ',Z.Revision,'  ',Z.Ident);
  226. End;
  227.  
  228.  
  229. Procedure FossilSendStr(S:String; Port:Word);
  230. Var
  231.   I:Byte;
  232. Begin
  233.   for I:=1 to byte(S[0]) do FossilSendChar(Port,byte(S[I]));
  234. End;
  235.  
  236. Procedure DialNo(Port:Word);
  237. Const SufixDial = 'ATDT';
  238. var
  239.   TelNo:String;
  240. Begin
  241.   WriteLn;
  242.   Write('Number to dial:');
  243.   ReadLn(TelNo);
  244.   if TelNo<>'' then begin
  245.     TelNo := SufixDial+TelNo+DialSuf;
  246.     FossilSendStr(TelNo,Port);
  247.   end;
  248. end;
  249.  
  250.  
  251. Procedure DialRec(Port:Word);
  252. var
  253.   SufixDial : String;
  254.   Num       : Integer;
  255.   BBSName   : String;
  256.   BBSNumber : String;
  257.   Password  : String;
  258.   Speed     : Integer;
  259.   TelNo     : String;
  260. Begin
  261. Writeln('TelNo is ',TelNo);
  262. TelNo := 'ATDT'+TelNo+DialSuf;
  263. FossilSendStr(TelNo,Port);
  264. End;
  265.  
  266. Procedure Run;
  267. var
  268.   Key :Word;
  269.   Done:Boolean;
  270. Begin
  271.   Done := False;
  272.   Repeat
  273.     If FossilIsCharReady(1)<>$FFFF Then Begin
  274.       Write(Chr(FossilReadChar(CurPort)));
  275.     End;
  276.     If FIsKeyPressed<>$FFFF Then Begin
  277.       Key:=FReadKey;
  278.       Case Key Of
  279.         ExitKey:Done:=True;
  280.         DialKey:DialNo(CurPort);
  281.         Else FossilSendChar(CurPort,Lo(Key));
  282.       End;
  283.  
  284.     End;
  285.   Until Done;
  286. End;
  287.  
  288. Procedure WriteAnsi;
  289. Var R : registers;
  290. Begin
  291.  R.AH := $13;
  292.  R.AL := ORD(FossilreadChar(CurPort));
  293.  Intr($14, R);
  294. End;
  295.  
  296. Procedure HangUp;
  297. Begin
  298.  FossilSendSTR('+++',CurPort);
  299.  FossilSendSTR('ATH0'+#13, CurPort);
  300. End;
  301.  
  302. Procedure Done;
  303. Begin
  304.   DeInitFossil(CurPort);
  305. End;
  306.  
  307. End.
  308.  
  309. { --------------------------------   DEMO PROGRAM --------------------- }
  310.  
  311. {$M 65520,65520,65520}
  312. Program AnsiEmu;
  313.  
  314. Uses Dos, Crt, FossilP;
  315. Const CurPort :Word=1;
  316.  
  317.       ExitKey     = $2d00; {ALT-X}
  318.       DialKey     = $2000; {ALT-D}
  319.       HangUpKey   = $2300; {ALT-H}
  320.       DownLoadKey = $2004; {CTRL+D}
  321.       UpLoadKey   = $1615; {CTRL+U}
  322.       ChangeSetUp = $2100; {ALT+F}
  323.       Menuu       = $2E00; {ALT+C}
  324.       PgUp        = $4900; {PageUp}
  325.       PgDown      = $5100; {PageDown}
  326.       ReadPhon    = $1900; {ALT+P}
  327.  
  328.  
  329.       DialPref :String='ATDT';
  330.       DialSuf  :String=#13;
  331.  
  332.  
  333. Var Key   : Word;
  334.     Done  : Boolean;
  335.     AnsiM : Char;
  336.  
  337. {ZMODEM'iga download}
  338. Procedure DownLoadZ;
  339. Begin
  340. SwapVectors;
  341. Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');
  342. SwapVectors;
  343. End;
  344.  
  345. Procedure UpLoadZ;
  346. Var FileName : String;
  347. Begin
  348. Write('Millist faili tahad Uppida: ');
  349. Readln(FileName);
  350. SwapVectors;
  351. Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);
  352. SwapVectors;
  353. End;
  354.  
  355. Procedure FirstKey;
  356. Var Vastus : Byte;
  357. Begin
  358. ClrScr;
  359. TextColor(red);
  360. Writeln('Millist Protocolli kasutad: ');
  361. Writeln;
  362. Writeln('1. Zmodem');
  363. Writeln('2. Puma  ');
  364. Writeln('3. SeaLink');
  365. Writeln;
  366. Write('Vastus: ');
  367. Readln(Vastus);
  368.  Case Vastus of
  369.   1 : DownLoadZ;
  370.  End; {End Case}
  371. TextColor(White);
  372. End;
  373.  
  374. Procedure DownLoad;
  375. Begin
  376. SwapVectors;
  377.  Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');
  378. SwapVectors;
  379. End;
  380.  
  381. Procedure UpLoad;
  382. Var FileName : String;
  383. Begin
  384.  Write('Enter Filename to UpLoad: ');
  385.   Readln(FileName);
  386.  SwapVectors;
  387.    Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);
  388.  SwapVectors;
  389. End;
  390.  
  391. Begin
  392. ClrScr;
  393. TextColor(White);
  394. Init;
  395.   Done:=False;
  396.   Repeat
  397.     If FossilIsCharReady(1)<>$FFFF then begin
  398.       {Write(Chr(FossilReadChar(CurPort)));}
  399.       WriteAnsi; {If ANSI loaded then color else BW}
  400.     End;
  401.     if FIsKeyPressed<>$FFFF then begin
  402.       Key:=FReadKey;
  403.       case Key of
  404.         ExitKey    : Done:=True;
  405.         DialKey    : DialNo(CurPort);
  406.         HangUpKey  : HangUp;
  407.         DownLoadKey: DownLoadZ;
  408.         UpLoadKey  : UpLoadZ;
  409.         PgDown     : FirstKey;                    {DownLoadSeaLink;}
  410.         PgUp       : UpLoad;
  411.  
  412.         Else FossilSendChar(CurPort, Lo(Key));
  413.       End;
  414.     End;
  415.   Until Done;
  416.  
  417.  Writeln('The End :-)');
  418. {PXDone;}
  419. TextColor(White);
  420. End.
  421.  
  422.